home *** CD-ROM | disk | FTP | other *** search
/ Fritz: All Fritz / All Fritz.zip / All Fritz / FILES / PROGSCAL / TBUTIL2.LZH / QLSORT.PAS < prev    next >
Pascal/Delphi Source File  |  1984-07-13  |  4KB  |  118 lines
  1. CONST max = 1000;   {max array size}
  2. TYPE standardarray = ARRAY[0..max] OF STRING[8];
  3. TYPE pointarray    = ARRAY[0..max] OF INTEGER;
  4. VAR  words     : standardarray; {numeric array}
  5.      pointer   : pointarray;
  6.      last,i    : INTEGER;
  7.  
  8.  
  9. PROCEDURE SWAP( VAR a,b: INTEGER );
  10. VAR t: INTEGER;
  11. BEGIN
  12.     t := a;
  13.     a := b;
  14.     b := t
  15. END;
  16.  
  17.  
  18. PROCEDURE bsort( start, top: INTEGER;
  19.                  VAR arry: standardarray;
  20.                  VAR pointer: pointarray );
  21. {bubble sort procedure. sorts array from start to top inclusive}
  22. VAR index:    INTEGER;
  23.     switched: BOOLEAN;
  24. BEGIN {bsort}
  25.     repeat
  26.          switched := FALSE;
  27.          FOR index := start TO top-1 DO
  28.              BEGIN
  29.                  IF arry[pointer[index]] > arry[pointer[index+1]] THEN
  30.                     BEGIN
  31.                         SWAP( pointer[index], pointer[index+1] );
  32.                         switched := TRUE;
  33.                     END
  34.              END;
  35.     UNTIL switched = FALSE;
  36. END; {bsort}
  37.  
  38. PROCEDURE findmedian( start, top: INTEGER;
  39.                        VAR arry: standardarray;
  40.                        VAR pointer : pointarray );
  41. {procedure to find a good median value in array and place it}
  42. VAR middle: INTEGER;
  43.     sorted: standardarray;
  44. BEGIN {findmedian}
  45.     middle    := (start + top) DIV 2;
  46.     sorted[1] := arry[pointer[start]];
  47.     sorted[2] := arry[pointer[top]];
  48.     sorted[3] := arry[pointer[middle]];
  49.  
  50.     IF (sorted[2] > sorted[1]) AND (sorted[2] < sorted[3]) THEN
  51.        SWAP( pointer[start], pointer[middle] )
  52.     ELSE IF (sorted[3] > sorted[1]) AND (sorted[3] < sorted[2])  THEN
  53.        SWAP( pointer[start], pointer[top] );
  54. END; {findmedian}
  55.  
  56. PROCEDURE sortsection( start, top: INTEGER;
  57.                        VAR arry: standardarray;
  58.                        VAR pointer : pointarray);
  59. {procedure to sort a section of the main array, and }
  60. {then divide it into two partitions to be sorted    }
  61. VAR swapup: BOOLEAN;
  62.     s,e,m:  INTEGER;
  63. BEGIN {sortsection}
  64.     IF top - start < 6 THEN {sort small sections with bsort}
  65.        bsort( start, top, arry , pointer )
  66.     ELSE
  67.        BEGIN
  68.            findmedian( start, top, arry , pointer );
  69.            swapup := TRUE;
  70.            {start scanning from array top}
  71.            s := start;  {lower comparison limit}
  72.            e := top;    {upper comparison limit}
  73.            m := start;  {location of comparison value}
  74.            WHILE e > s DO
  75.                BEGIN
  76.                    IF swapup = TRUE THEN
  77.                       {scan downward from partition top}
  78.                       {and exchange if smaller than median}
  79.                       BEGIN
  80.                           WHILE( arry[pointer[e]] >= arry[pointer[m]] )
  81.                                      AND (e > m)  DO
  82.                               e := e - 1;
  83.                           IF e > m THEN
  84.                              BEGIN
  85.                                  SWAP( pointer[e], pointer[m] );
  86.                                  m := e;
  87.                              END;
  88.                           swapup := FALSE;
  89.                       END
  90.                    ELSE
  91.                       {scan upward from a partition start}
  92.                       {and exchange if larger than median}
  93.                       BEGIN
  94.                           WHILE( arry[pointer[s]] <= arry[pointer[m]] )
  95.                                   AND (s < m) DO
  96.                               s := s + 1;
  97.                           IF s < m THEN
  98.                              BEGIN
  99.                                  SWAP( pointer[s], pointer[m] );
  100.                                  m := s;
  101.                              END;
  102.                           swapup := TRUE;
  103.                       END
  104.                END;
  105.                 {sort lower half of partition}
  106.            sortsection( start, m-1, arry , pointer );
  107.                 {sort upper half of partition}
  108.            sortsection( m+1, top, arry , pointer);
  109.            END
  110. END; {sortsection}
  111.  
  112. BEGIN {qsort - main program}
  113.     FOR i := 1 TO max DO
  114.        pointer[i]  := i;
  115.  
  116.     sortsection( 1, max , words , pointer );
  117. END. {qsort}
  118.